home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PASCALL / VIDEO / FVID.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-16  |  4KB  |  153 lines
  1. unit FVid;
  2. interface
  3. uses
  4.    Crt,FPal,Objects;
  5. const
  6.    BlendFrames                                     =     10;
  7.    BlendColors                                     =     10;
  8.    DivitnBlends                                    =     3*BlendColors;
  9. type
  10.    AFPRgbs=array[0..DivitnBlends] of RFPRgb;
  11.  
  12.    PDeveder=^TDeveder;
  13.    TDeveder=object(TObject)
  14.       Blends                                       :     AFPRgbs;
  15.     constructor Init;
  16.       procedure Get(n:Integer; var A:RFPRgb);            virtual;
  17.    end;
  18.  
  19.    PVid=^TVid;
  20.    TVid=object(TObject)
  21.       Blendes                                      :     TDeveder;
  22.       Orig                                         ,
  23.       Access                                       :     TFPPal;
  24.       At1                                          ,
  25.       At2                                          :     Integer;
  26.     constructor Init(n:Byte);
  27.       procedure Bo;                                      virtual;
  28.      destructor Done;                                    virtual;
  29.    end;
  30.  
  31.  
  32. implementation
  33. {TObject.TDeveder}
  34. constructor TDeveder.Init;
  35.    procedure Build(var Z:AFPRgbs; A,B:Integer);
  36.    begin
  37.       if ((A+B) div 2<>A) and ((A+B) div 2<>B) then
  38.       begin
  39.          Z[(A+B) div 2].Red  :=Z[A].Red  +Z[B].Red;
  40.          Z[(A+B) div 2].Green:=Z[A].Green+Z[B].Green;
  41.          Z[(A+B) div 2].Blue :=Z[A].Blue +Z[B].Blue;
  42.          Build(Z,A,(A+B) div 2);
  43.          Build(Z,(A+B) div 2,B);
  44.       end;
  45.    end;
  46.    procedure AverageOut(var Z:AFPRgbs);
  47.    var
  48.       a:Integer;
  49.       b:Real;
  50.    begin
  51.       for a:=0 to DivitnBlends do
  52.       begin
  53.          with Z[A] do
  54.          begin
  55.             b:=0;
  56.             if Red>b then b:=Red;
  57.             if Green>b then b:=Green;
  58.             if Blue>b then b:=Blue;
  59.             if b>0 then
  60.             begin
  61.                Red:=100*(Red/b);
  62.                Green:=100*(Green/b);
  63.                Blue:=100*(Blue/b);
  64.             end;
  65.          end;
  66.       end;
  67.    end;
  68. begin
  69.    inherited Init;
  70.    Blends[0].Red:=1;
  71.    Blends[DivitnBlends div 3].Green:=1;
  72.    Blends[2*(DivitnBlends div 3)].Blue:=1;
  73.    Blends[DivitnBlends].Red:=1;
  74.  
  75.    Build(Blends,0,DivitnBlends div 3);
  76.    Build(Blends,DivitnBlends div 3,2*(DivitnBlends div 3));
  77.    Build(Blends,2*(DivitnBlends div 3),DivitnBlends);
  78.  
  79.    AverageOut(Blends);
  80. end;
  81. procedure   TDeveder.Get(n:Integer; var A:RFPRgb);
  82. begin
  83.    A:=Blends[n];
  84. end;
  85.  
  86. {TObject.TVid}
  87. constructor TVid.Init(n:Byte);
  88. begin
  89.    inherited Init;
  90.    Blendes.Init;
  91.    Orig.Init(n);
  92.    Orig.Copy;
  93.    Access.Init(n);
  94.    Access.Copy;
  95. end;
  96. procedure   TVid.Bo;
  97. var
  98.    A,B,C:RFPRgb;
  99.    function Incr(A:Integer; B,C:Real):Real;
  100.    var
  101.       t:Real;
  102.    begin
  103.       t:=B-C;
  104.       Incr:=B-(((A)*t)/BlendFrames);
  105.    end;
  106.    procedure Incre(A:Integer; var B,C,D:RFPRgb);
  107.    begin
  108.       D.Red:=  Incr(A,B.Red,C.Red);
  109.       D.Green:=Incr(A,B.Green,C.Green);
  110.       D.Blue:= Incr(A,B.Blue,C.Blue);
  111.    end;
  112.    procedure updatergb(a:integer; b,c,d:real);
  113.    begin
  114.      gotoxy(1,1);
  115.       write('Color:');
  116.       writeln(a:24);
  117.      gotoxy(1,3);
  118.       write('RED:');
  119.       writeln(b:26:10);
  120.      gotoxy(1,4);
  121.       write('GREEN:');
  122.       writeln(c:24:10);
  123.      gotoxy(1,5);
  124.       write('BLUE:');
  125.       writeln(d:25:10);
  126.    end;
  127. begin
  128.    Blendes.Get(At1,A);
  129.    Blendes.Get(At1+1,B);
  130.    Incre(At2,A,B,C);
  131.    with C do
  132.    begin
  133.       Access.This(Red,Green,Blue);
  134. {      UpDateRgb(0,Red,Green,Blue);}
  135.    end;
  136.    Inc(At2);
  137.    if At2=BlendFrames+1 then
  138.    begin
  139.       Inc(At1);
  140.       At2:=0;
  141.    end;
  142.    if At1=DivitnBlends then At1:=0;
  143. end;
  144. destructor  TVid.Done;
  145. begin
  146.    Orig.Push;
  147.    inherited Done;
  148. end;
  149.  
  150.  
  151.  
  152.  
  153. end.